Your Choice 3/Your Choice Software Collection 3.iso/prgmming/swag08/mouse.swg

Text File | 1994-09-22 | 53KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00004                                                                           1      08-24-9413:46ALL                      ANDREW EIGUS             Good Mouse Support       SWAG9408    bFƒ⌡    45     l╚   πUnit Mouse;π{ Copyright (c) 1991, Crazy Systems Software, Inc. }ππ{$G+}ππ{π *************************************************π *                                               *π *       Mouse in Text Mode Interface Unit       *π *            for Borland Pascal 7.0             *π *                                               *π *      Completely written by  Andrew Eigus      *π *************************************************π}ππinterfaceππtypeπ  TMouseWinRect = recordπ    X1, Y1, X2, Y2 : wordπ  end;ππ  TMouseParamTable = recordπ    BaudRate,  { Baud rate / 100 }π    Emulation,π    ReportRate, { Report rate }π    FirmRev,π    ZeroWord,  { Should be zero }π    Port,  { Com Port used }π    PhysButtons, { Physical buttons }π    LogButtons : word { Logical buttons }π  end;ππ  TMouseRec = recordπ    Keys,π    Hzints,π    Page,π    XCoord,π    YCoord,π    HSpeed,π    VSpeed,π    DSpeed : word;π    Column,π    Row : byte;π    W : TMouseWinRect;π    ButtonClicked : byte;π    ParamTable : TMouseParamTableπ  end;ππconstπ  LeftButton  = 1;π  MidButton   = 4;π  RightButton = 2;ππ  mNoInts    = 0;π  m30HzInts  = 1;π  m50HzInts  = 2;π  m100HzInts = 3;π  m200HzInts = 4;ππvarπ  M : TMouseRec;π  MouseInstalled : boolean;ππfunction InstallMouse : boolean;πfunction GetMouseInfo(var M : TMouseRec) : byte;πfunction ButtonReleased : boolean;πprocedure SetMouseCursor(CursorOn : boolean);πprocedure SetMouseCursorType(HotSpotX, HotSpotY : word; var CursorImage);πprocedure MoveMouseTo(XCoord, YCoord : integer);πprocedure SetMouseWindow(X1, Y1, X2, Y2 : word);πprocedure GetMouseSpeed;πprocedure SetMouseSpeed(HorSpeed, VrtSpeed, DblSpeed : integer);πprocedure SetMouseInts(Hz : word);πfunction GetMousePage : word;πprocedure SetMousePage(Page : word);πprocedure UninstallMouse;ππimplementationππFunction InstallMouse; assembler;πAsmπ  XOR AX,AX  { zero function }π  INT 33hπ  CMP AL,0π  JE  @@1π  MOV MouseInstalled,Trueπ  LEA DI,Mπ  MOV [ES:DI](TMouseRec).Keys,0π  MOV [ES:DI](TMouseRec).Keys,BXπ  PUSH ESπ  PUSH DIπ  CALL GetMouseInfoπ  CALL GetMousePageπ  CALL GetMouseSpeedπ  MOV [ES:DI](TMouseRec).W.X1,1π  MOV [ES:DI](TMouseRec).W.Y1,1π  MOV [ES:DI](TMouseRec).W.X2,639π  MOV [ES:DI](TMouseRec).W.Y2,199π  MOV AX,246Chπ  LEA DX,M.ParamTableπ  INT 33hπ  MOV AL,Trueπ@@1:πEnd; { InstallMouse }ππFunction GetMouseInfo; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,0003hπ  INT 33hπ  LES DI,Mπ  MOV [ES:DI](TMouseRec).XCoord,CXπ  SHR CX,3π  INC CLπ  MOV [ES:DI](TMouseRec).Column,CLπ  MOV [ES:DI](TMouseRec).YCoord,DXπ  SHR DX,3π  INC DLπ  MOV [ES:DI](TMouseRec).Row,DLπ  MOV [ES:DI](TMouseRec).ButtonClicked,BLπ  MOV AL,BL   { LeftButton, MidButton or RightButton }π@@1:πEnd; { GetMouseInfo }ππFunction ButtonReleased; assembler;πAsmπ  LEA DI,Mπ  PUSH ESπ  PUSH DIπ  CALL GetMouseInfoπ  MOV AL,Trueπ  CMP BL,0π  JE  @@1π  MOV AL,Falseπ@@1:πEnd; { ButtonReleased }ππProcedure SetMouseCursor; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@2π  MOV AX,0001hπ  CMP CursorOn,Trueπ  JE  @@1π  MOV AX,0002hπ@@1:π  INT 33hπ@@2:πEnd; { SetMouseCursor }ππProcedure SetMouseCursorType; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,000Ahπ  MOV BX,HotSpotXπ  MOV CX,HotSpotYπ  LES DX,CursorImageπ  INT 33hπ@@1:πEnd; { SetMouseCursorType }ππProcedure MoveMouseTo; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,0004hπ  MOV CX,XCoordπ  MOV DX,YCoordπ  INT 33hπ@@1:πEnd; { MoveMouseTo }ππProcedure SetMouseWindow; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  LEA DI,Mπ  MOV AX,0007hπ  MOV CX,X1π  MOV [ES:DI](TMouseRec).W.X1,CXπ  MOV DX,X2π  MOV [ES:DI](TMouseRec).W.X2,DXπ  INT 33hπ  MOV AX,0008hπ  MOV CX,Y1π  MOV [ES:DI](TMouseRec).W.Y1,CXπ  MOV DX,Y2π  MOV [ES:DI](TMouseRec).W.Y2,DXπ  INT 33hπ@@1:πEnd; { SetMouseWindow }ππProcedure GetMouseSpeed; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,001Bhπ  INT 33hπ  LEA DI,Mπ  MOV [ES:DI](TMouseRec).HSpeed,BXπ  MOV [ES:DI](TMouseRec).VSpeed,CXπ  MOV [ES:DI](TMouseRec).DSpeed,DXπ@@1:πEnd; { GetMouseSpeed }ππProcedure SetMouseSpeed; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,001Ahπ  MOV BX,HorSpeedπ  MOV CX,VrtSpeedπ  MOV DX,DblSpeedπ  INT 33hπ  CALL GetMouseSpeedπ@@1:πEnd; { SetMouseSpeed }ππProcedure SetMouseInts; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,001Chπ  MOV BX,Hzπ  INT 33hπ@@1:πEnd; { SetMouseInts }ππFunction GetMousePage; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,001Ehπ  INT 33hπ  LEA DI,Mπ  MOV [ES:DI](TMouseRec).Page,BXπ  MOV AX,BXπ@@1:πEnd; { GetMousePage }ππProcedure SetMousePage; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,001Dπ  MOV BX,Pageπ  INT 33hπ  CALL GetMousePageπ@@1:πEnd; { SetMousePage }ππProcedure UninstallMouse; assembler;πAsmπ  CMP MouseInstalled,Trueπ  JNE @@1π  MOV AX,0020hπ  INT 33hπ@@1:πEnd; { UninstallMouse }ππBeginπ  MouseInstalled := False;π  FillChar(M, SizeOf(TMouseRec), 0)πEnd. { Mouse }ππ{---now the demo program---}ππProgram MouDemo;ππuses Crt, Mouse;ππBeginπ  if InstallMouse thenπ  beginπ    ClrScr;π    SetMouseCursor(True);π    WriteLn('Mouse is installed.');π    WriteLn('Click left mouse button in the upper left corner of your ' +π      'screen to quit.');π    repeatπ      GetMouseInfo(M);π    until (M.ButtonClicked = LeftButton) and (M.Column = 1) and (M.Row = 1);π    Write('Waiting to release left button...');π    repeat until ButtonReleased;π    Write(#13);π    ClrEol;π    SetMouseCursor(False);π    UninstallMouseπ  end else WriteLn('Mouse is NOT installed.')πEnd.ππ                                                                                                                  2      08-24-9413:46ALL                      FRED JOHNSON             Good Mouse Support       SWAG9408    Σ╛└    80     l╚   πunit mouse3;π{-------------------------------------------------------------------------πReference Tableπ  M1 M2 M3 M4π  1  0  0  0   = Turn Mouse on with cursor.π  2  0  0  0   = Turn Mouse Off.π  3  ?  ?  ?   = To see if buttons are pressed.π                  Test registers with logical AND   (M2 is BX register)π                  M2 and 1 = Left Buttonπ                  M2 and 2 = Right Buttonπ                  M2 and 3 = Left and Right Buttonsπ                  M2 and 4 = Middle Buttonπ                  M2 and 5 = Left and Middle Buttonsπ                  M2 and 6 = Right and Middle Buttonsπ                  M2 and 7 = Left, Middle and Right Buttonsππ  3  0  X  Y  = Get Mouse Cursor position.π                 M3 (CX) will return Mouse X coordinates. ( 0   = left wall)π                 M4 (DX) will return Mouse Y coordinates. ( 632 = right wall)π                 Divide by 8 and add 1 for Turbo Pascal XY position.ππ  4  0  X  Y  = Set Mouse Cursor position.π                 M3 (CX) set for Mouse X coordinate.      ( 0   = left wall)π                 M4 (DX) set for Mouse Y coordinate.      ( 632 = right wall)ππ  6  ?  0  0  = Mouse Button Release Status.              M2 (BX) set if Trueπ}ππinterfaceππUSES dos,crt;ππTYPEπ   xMouseFuncs = recordπ      bFunction : function : boolean;π   end;ππVARπ   M1,M2,M3,M4 : word;π   Regs        : Registers;  { MS DOS Registers }ππPROCEDURE Mouse( var M1,M2,M3,M4 : word );πPROCEDURE DeInitMouse;πPROCEDURE InitMouse;πPROCEDURE GetMousePos;πPROCEDURE GetMouseStats;πPROCEDURE SetMousePos(xM3, yM4:word);ππFUNCTION  MPos(wPosition : word) : word;πFUNCTION  LeftButton             : Boolean;πFUNCTION  LeftAndRightButtons    : Boolean;πFUNCTION  LeftAndMiddleButtons   : Boolean;πFUNCTION  RightAndMiddleButtons  : Boolean;πFUNCTION  LeftMidAndRightButtons : Boolean;πFUNCTION  MiddleButton           : Boolean;πFUNCTION  RightButton            : Boolean;πFUNCTION  MouseRelease           : boolean;ππconstπ   MouseButton : array[1..7] of xMouseFuncs =π      (π      (bFunction : LeftButton),π      (bFunction : RightButton),π      (bFunction : LeftAndRightButtons),π      (bFunction : MiddleButton),π      (bFunction : LeftAndMiddleButtons),π      (bFunction : RightAndMiddleButtons),π      (bFunction : LeftMidAndRightButtons)π      );ππ   MOUSE_REST  = 0;π   MOUSE_L     = 1;π   MOUSE_R     = 2;π   MOUSE_L_R   = 3;π   MOUSE_M     = 4;π   MOUSE_L_M   = 5;π   MOUSE_R_M   = 6;π   MOUSE_L_M_R = 7;ππimplementationπππFUNCTION MPos(wPosition : word) : word;π   beginπ      MPos := (wPosition div 8)+1;π   end;ππFUNCTION LeftButton : Boolean;π   beginπ      LeftButton := FALSE;π      if (M2 and 1) <> MOUSE_REST thenπ         begin                { if left button pressed }π            LeftButton := TRUE;π         end;π   end;ππFUNCTION RightButton : Boolean;π   beginπ      RightButton := FALSE;π      if (M2 and 2) <> MOUSE_REST thenπ         begin                { if right button pressed }π            RightButton := TRUE;π         end;π   end;ππFUNCTION LeftAndRightButtons : Boolean;π   beginπ      LeftAndRightButtons := FALSE;π      if (M2 and 3) = 3 thenπ         beginπ            LeftAndRightButtons := TRUE;π         end;π   end;ππFUNCTION MiddleButton : Boolean;π   beginπ      MiddleButton := FALSE;π      if (M2 and 4) <> MOUSE_REST thenπ         beginπ            MiddleButton := TRUE;π         end;π   end;ππFUNCTION LeftAndMiddleButtons : Boolean;π   beginπ      LeftAndMiddleButtons := FALSE;π      if (M2 and 5) = MOUSE_L_M thenπ         beginπ            LeftAndMiddleButtons := TRUE;π         end;π   end;ππFUNCTION RightAndMiddleButtons : Boolean;π   beginπ      RightAndMiddleButtons := FALSE;π      if (M2 and 6) = MOUSE_R_M thenπ         beginπ            RightAndMiddleButtons := TRUE;π         end;π   end;ππFUNCTION LeftMidAndRightButtons : Boolean;π   beginπ      LeftMidandRightButtons := FALSE;π      if (M2 and 7) = MOUSE_L_M_R thenπ         beginπ            LeftMidAndRightButtons := TRUE;π         end;π   end;ππFUNCTION MouseRelease : boolean;π  beginπ     MouseRelease := FALSE;π     M1 := 6;π     Mouse( M1,M2,M3,M4 ); { Set mouse cursor ON }π     if MOUSE_REST <> M2 thenπ        beginπ           MouseRelease := TRUE;π        end;π  end;ππPROCEDURE Mouse( var M1,M2,M3,M4 : word );π   beginπ      With Regs DOπ         beginπ            AX := M1;π            BX := M2;π            CX := M3;π            DX := M4;π         end;π      intr($33,Regs); { Interrupt $33, the mouse interrupt }ππ      With Regs DOπ         beginπ            M1 := AX;π            M2 := BX;π            M3 := CX;π            M4 := DX;π         end;π  end;ππPROCEDURE InitMouse;π  beginπ     M1 := 1;π     Mouse( M1,M2,M3,M4 ); { Set mouse cursor ON }π  end;ππPROCEDURE DeInitMouse;π  beginπ     M1 := 2;π     Mouse( M1,M2,M3,M4 ); { Set mouse cursor OFF }π  end;ππPROCEDURE GetMousePos;π   beginπ      M1 := 3;π      Mouse(M1, M2, M3, M4);π   end;πππPROCEDURE GetMouseStats;π   beginπ      M1 := 3;π      M2 := 0;π      M3 := 0;π      m4 := 0;π      Mouse(M1, M2, M3, M4);π   end;ππPROCEDURE SetMousePos(xM3, yM4:word);π   beginπ      M1 := 4;π      Mouse(M1, M2, xM3, yM4);π   end;ππbeginπ   initmouse; {Take this out if you do not wish mouse to auto initialize}πend.ππ{-----------------------------   DEMO PROGRAM ---------------------}ππUSES dos, crt, mouse3, Frame2;ππVARπ   satisfied  : boolean;    { if mouse pos and button are together }ππCONSTπ   Menu_ClrScr = 'C';π   Menu_Quit   = 'Q';ππPROCEDURE DO_Mssg;π   beginπ      gotoxy(1,24);π      writeln('Push Middle Button or L/R buttons together for menu');π      write('XY Coordinates totalling 40 will produce beep');π   end;ππFUNCTION MenuHit(cChar : char) : Boolean;π   beginπ      GetMousePos;π      MenuHit := FALSE;π      if (27 = MPos(M3)) and (MouseButton[MOUSE_L].bFunction) thenπ         beginπ            if (Menu_ClrScr = cChar) and (11 = MPos(M4)) thenπ               beginπ                  MenuHit := TRUE;π                  ClrScr;π                  Do_Mssg;π                  exit;π               end;ππ            if (Menu_Quit = cChar) and (12 = MPos(M4)) thenπ               beginπ                  MenuHit := TRUE;π                  exit;π               end;π         end;π   end;ππBEGINπ   satisfied := false;π   textcolor(7); { Grey }π   ClrScr;π   Do_Mssg;ππ   while not keypressed do { until  KEYBOARD key is pressed }π      beginπ         GetMouseStats;π         gotoxy(1,1);π         write('M3 =',MPos(M3):2,π            ' M4 =',MPos(M4):2);ππ         if (MPos(M3)+MPos(M4) = 40) thenπ            beginπ               write(#7);π            end;ππ         if MouseButton[MOUSE_L].bFunction  thenπ            beginπ               gotoxy(16,1);π               write('Left Button');π               clreol;π            end;ππ         if MouseButton[MOUSE_R].bFunction thenπ            beginπ               gotoxy(16,1);π               write('Right Button');π               clreol;π            end;ππ         if (MouseButton[MOUSE_M].bFunction= TRUE) or      {Middle Button}π            (MouseButton[MOUSE_L_R].bFunction = TRUE) then  {Left & Right}π               beginπ                  SetMousePos(30*8, 11*8);  { Sets MCursor out of way }π                  Frame(1,25,10,39,13);π                  gotoxy(26,11);π                  textcolor(14);π                  write(' ',Menu_ClrScr);π                  textcolor(07);π                  write('learscreen');π                  gotoxy(26,12);π                  textcolor(14);π                  write(' ',Menu_Quit);π                  textcolor(07);π                  write('uit');π                  repeatπ                     if MenuHit(Menu_ClrScr) = TRUE thenπ                        beginπ                           satisfied := true;π                           SetMousePos(0,0); {Sets MCursor out of way }π                        end;π                     gotoxy(1,1);π                     write('M3 =',MPos(M3):2,π                        ' M4 =',MPos(M4):2);π                     clreol;ππ                     if MenuHit(Menu_Quit) = TRUE thenπ                        beginπ                           satisfied := true;π                           DeInitMouse;π                           ClrScr;π                           halt;π                        end;π                  until satisfied = true;π                  {ClrScr;}π               end;π         satisfied := false;π      end;π   DeInitMouse;                                        { Turn Mouse Off }π   ClrScr;πEND.ππ{ ------------------   UNIT FOR DEMO ABOVE -------------------- }ππunit frame2;πinterfaceπuses crt;ππCONSTπ   DtDs = 1;π   StSs = 2;π   DtSs = 3;π   StDs = 4;ππ   xSides : array[1..4, 1..6] of char = {xSides:array[1..4,1..6]of char =}π      (                                 {   (}π      (#201,#205,#187,#186,#200,#188),  {   ('╔','═','╗','║','╚','╝'),}π      (#218,#196,#191,#179,#192,#217),  {   ('┌','─','┐','│','└','┘'),}π      (#213,#205,#184,#179,#212,#190),  {   ('╒','═','╕','│','╘','╛'),}π      (#214,#196,#183,#186,#211,#189)   {   ('╓','─','╖','║','╙','╜')}π      );                                {   );}ππprocedure Frame(π   iSideType,π   iUpperLeftX,π   iUpperLeftY,π   iLowerRightX,π   iLowerRightY  : Integer);ππimplementationππprocedure Frame(π   iSideType,π   iUpperLeftX,π   iUpperLeftY,π   iLowerRightX,π   iLowerRightY   : Integer);ππvarπ   i: Integer;ππbeginπ   GotoXY(iUpperLeftX, iUpperLeftY);π   Write(xSides[iSideType][1]);π   for i:= iUpperLeftX+1 to iLowerRightX-1 doπ      beginπ         Write(xSides[iSideType][2]);π      end;π   Write(xSides[iSideType][3]);π   for i:= iUpperLeftY+1 to iLowerRightY-1 doπ     beginπ       GotoXY(iUpperLeftX , i);π       Write(xSides[iSideType][4]);π       GotoXY(iLowerRightX, i);π       Write(xSides[iSideType][4]);π     end;π   GotoXY(iUpperLeftX, iLowerRightY);π   Write(xSides[iSideType][5]);π   for i:= iUpperLeftX+1 to iLowerRightX-1 doπ      beginπ         Write(xSides[iSideType][2]);π      end;π   Write(xSides[iSideType][6]);πend;ππend.π                                                                                                             3      08-24-9413:57ALL                      JOHN HOWARD              Anivga Sprite Mouse V0.4 SWAG9408    +
Y    40     l╚   (* ************************************************************************π   Example of ANIVGA sprite mouse using the default TurboVision Drivers unit.π   Procedures in Drivers unit divide MouseInt coordinates (i.e. SAR 3) by 8 toπ   convert into TPoint screen coordinates.  TPoint is an object containing aπ   pair of Integers.  Consequently, the default mouse is pixel precise for X =π   0..79 and Y = 0..24 but should be scaled back up for a larger range.ππ   Changing the source code from the Drivers unit is best approach.  Make aπ   clone unit that has the same keyboard/mouse constants and routines for theπ   event-loop.  And ignore the rest.  Otherwise multiply TEvent.Where valuesπ   by 8 repeatedly.  As shown, precision is reduced to 8 pixels as a result.π   ************************************************************************ *)π{$A+,B-,D+,L+,N-,E-,O-,R-,S-,V-,G-,F-,I-,X-}π{$M 16384,0,655360}πPROGRAM SpriteMouse;π{ Author: John Howard  jhπ  Version 0.4π  Date: July 23, 1994π}πUSES {original sinusoid code from Kai Rohrbacher}π     ANIVGAπ    ,Drivers;            {TurboVision event-driven mouse & keyboard}ππCONST LoadNumber=42;π      TileName='AEGYPTEN.COD';  {Path & name of any sprite tile to load}π      FirstTile=0;π      Tiles_per_Row=2;          {TileWidth}π      Tiles_per_Column=2;       {TileHeight}π      SpriteName='FLOWER.COD';  {Path & name of any sprite to load}π      CartoonName='HANTEL.LIB'; {Path & name of animated mouse cursor library}π      CartoonHandle=1;π      Cartoon=1;                {sprite number}π      MouseHandle=LoadNumber;   {Clone mouse cursor}π      Mouse=0;                  {sprite number}π      Surf=Mouse +15;           {just a sprite number above split index}π      OFF=0;                    {Switch sprite OFF}πVARπ    x : INTEGER;π    Event : TEvent;      {Drivers}π    MaxFrame : word;π    FrameCount : word;ππCONSTπ{ CRT Foreground and background color constants }π  Black         = 0;π  Blue          = 1;π  Green         = 2;π  Cyan          = 3;π  Red           = 4;π  Magenta       = 5;π  Brown         = 6;π  LightGray     = 7;ππ{ CRT Foreground color constants }π  DarkGray      = 8;π  LightBlue     = 9;π  LightGreen    = 10;π  LightCyan     = 11;π  LightRed      = 12;π  LightMagenta  = 13;π  Yellow        = 14;π  White         = 15;ππBEGINπ IF loadSprite(SpriteName,LoadNumber)=0π  THEN BEGINπ        WRITELN('Couldn''t access file '+SpriteName+' : '+GetErrorMessage);π        halt(1)π       END;π MaxFrame:=loadSprite(CartoonName,CartoonHandle);π{$IFDEF DEBUG}π    writeln(CartoonName+' contains : ', MaxFrame); halt(1);π{$ENDIF}π IF Error<>Err_Noneπ  THEN BEGINπ        WRITELN('Couldn''t access file '+CartoonName+' : '+GetErrorMessage);π        halt(1)π       END;π InitEvents;             {Drivers}π HideMouse;              {Drivers}ππ InitGraph;π IF loadTile(TileName, FirstTile)=0π  THEN BEGINπ        CloseRoutines;π        DoneEvents;      {Drivers}π        WRITELN('Couldn''t access file '+TileName+' : '+GetErrorMessage);π        halt(1)π       END;π FillBackground(LightRed);               {Border}π SetAnimateWindow(32,24, XMAX-32, YMAX-24);π SetBackgroundMode(SCROLLING);           {Tiles}π SetBackgroundScrollRange(0,0,XMAX,YMAX);  {Tiles}π MakeTileArea(FirstTile,Tiles_per_Row,Tiles_per_Column);ππ SetSplitIndex(Mouse + MaxFrame);π SetCycleTime(30);                       {millisec between frames}π SpriteN[Surf]:=LoadNumber;π SpriteN[Mouse]:=MouseHandle;            {clone sprite for default mouse}ππ FrameCount := 1;                        {min frame number}π repeatπ FOR x:=0 TO XMAX DO                     {vary the horizontal}π  BEGINπ   SpriteX[Surf]:=x;                     {sinusoid}π   SpriteY[Surf]:=TRUNC( sin(2.0*pi*x/XMAX)*(YMAX SHR 1)+YMAX SHR 1 );ππ   Event.What := evNothing;              {ClearEvent}π   GetMouseEvent(Event); {Drivers}π   if (Event.What and evMouse) <> 0 thenπ     if (Event.What = evMouseAuto) thenπ     begin   {animate mouse when button held down.  Note: sporadic reporting}π        SpriteN[Cartoon]:= OFF;π        SpriteN[Mouse]:= OFF;π        if (FrameCount < MaxFrame) then  {min..max frame or restart}π          inc(FrameCount)  {min frame number}π        elseπ          FrameCount := 1;               {start}π        SpriteN[Cartoon]:= FrameCount;π        SpriteX[FrameCount]:= Event.Where.X shl 3;π        SpriteY[FrameCount]:= Event.Where.Y shl 3;π     endπ     elseπ     begin   {default mouse cursor}π        SpriteN[Cartoon]:= OFF;π        SpriteN[Mouse]:= MouseHandle;π        SpriteX[Mouse]:= Event.Where.X shl 3;π        SpriteY[Mouse]:= Event.Where.Y shl 3;π     end; {if}π   {if "mouse (X,Y) within ClipRectangle" then}π   UpdateOuterArea := 2;                 {Required for non-dynamic background}π   Animate;π  END;ππ  GetKeyEvent(Event);    {Drivers}π until (Event.What = evKeyDown);         {keypressed}ππ CloseRoutines;π DoneEvents;             {Drivers}πEND.π                                                                                4      08-24-9417:53ALL                      OLAF BARTELT             Graphics Mouse Cursor    SWAG9408    σ┴±«    249    l╚   πUNIT  uMCursor;                               { (c) 1994 by NEBULA-Soft. }π      { Mausroutinen für Textmodus          } { Olaf Bartelt & Oliver Carow }π{ ═════════════════════════════ } INTERFACE { ═════════════════════════════ }πUSES  DOS, video;                             { Einbinden der Units         }ππ{ The unit VIDEO is also included in the SWAG distribution in the CRT.SWG   }ππ{ ─ Konstantendeklarationen ─────────────────────────────────────────────── }πCONST cLinke_taste                 = 1;       { linke Maustaste             }π      cRechte_taste                = 2;       { rechte Maustaste            }π      cMittlere_taste              = 4;       { mittlere Maustaste (bei 3)  }ππ      cursor_location_changed      = 1;π      left_button_pressed          = 2;π      left_button_released         = 4;π      right_button_pressed         = 8;π      right_button_released        = 16;π      middle_button_pressed        = 32;π      middle_button_released       = 64;ππ      lastmask                     : WORD    = 0;π      lasthandler                  : POINTER = NIL;ππ      click_repeat                 = 10;π      mousetextscale               = 8;π      vgatextgraphiccursor         : BOOLEAN = FALSE;πππ{ ─ Typendeklarationen ──────────────────────────────────────────────────── }πTYPE  mousetype                    = (twobutton, threebutton, another);π      buttonstate                  = (buttondown, buttonup);π      direction                    = (moveright, moveleft, moveup, movedown,πnomove);ππ{ ─ Variablendeklarationen ──────────────────────────────────────────────── }πVAR   mouse_present                : BOOLEAN;π      mouse_buttons                : mousetype;π      eventx, eventy, eventbuttons : WORD;π      eventhappened                : BOOLEAN;π      xmotions, ymotions           : WORD;π      mousecursorlevel             : INTEGER;π      fontpoints                   : BYTE;ππ      maxmousex             : INTEGER;π      maxmousey                    : INTEGER;πππ{ ─ exportierte Prozeduren und Funktionen ───────────────────────────────── }πPROCEDURE set_graphic_mouse_cursor;        { graphischen Mousecursor setzen }πPROCEDURE showmousecursor;ππ{ ══════════════════════════ } IMPLEMENTATION { ═══════════════════════════ }π{$IFDEF VER60}                                { in TP 6.0 gibt es SEGxxxx   }πCONST SEG0040 = $0040;                        { noch nicht! => definieren!  }π      SEGB800 = $B800;π      SEGA000 = $A000;π{$ENDIF}ππ{ ─ Typendeklarationen ──────────────────────────────────────────────────── }πTYPE  pTextgraphikcursor = ^tTextgraphikcursor;  { Zeiger auf Array         }π      tTextgraphikcursor = ARRAY[0..31] OF LONGINT;ππ      box                = RECORDπ                             left, top, right, bottom : WORD;π                           END;π      pChardefs          = ^tChardefs;π      tChardefs          = ARRAY[0..(32*8)] OF BYTE;ππ{ ─ Konstantendeklarationen ─────────────────────────────────────────────── }πCONST pfeil                  : tTextgraphikcursor =π{ Maske:  } ($3FFFFFFF, $1FFFFFFF, $0FFFFFFF, $07FFFFFF, $03FFFFFF, $01FFFFFF,π             $00FFFFFF, $007FFFFF, $003FFFFF, $007FFFFF, $01FFFFFF, $10FFFFFF,π             $B0FFFFFF, $F87FFFFF, $F87FFFFF, $FcFFFFFF,π{ Cursor: }  $00000000, $40000000, $60000000, $70000000, $78000000, $7C000000,π             $7E000000, $7F000000, $7F800000, $7F000000, $7C000000, $46000000,π             $06000000, $03000000, $03000000, $00000000);ππ      sanduhr : tTextgraphikcursor =        ($0001FFFF,  { 0000000000000001 }π                { Cursorform:      }         $0001FFFF,  { 0000000000000001 }π                                             $8003FFFF,  { 1000000000000011 }π                                             $C7C7FFFF,  { 1100011111000111 }π                                             $E38FFFFF,  { 1110001110001111 }π                                             $F11FFFFF,  { 1111000100011111 }π                                             $F83FFFFF,  { 1111100000111111 }π                                             $FC7FFFFF,  { 1111110001111111 }π                                             $F83FFFFF,  { 1111100000111111 }π                                             $F11FFFFF,  { 1111000100011111 }π                                             $E38FFFFF,  { 1110001110001111 }π                                             $C7C7FFFF,  { 1100011111000111 }π                                             $8003FFFF,  { 1000000000000011 }π                                             $0001FFFF,  { 0000000000000001 }π                                             $0001FFFF,  { 0000000000000001 }π                                             $0000FFFF,  { 0000000000000000 }π                                                { ^^^^ immer! (Textmodus)   }π                { Bildschirmmaske: }         $00000000,  { 0000000000000000 }π                                             $7FFC0000,  { 0111111111111100 }π                                             $20080000,  { 0010000000001000 }π                                             $10100000,  { 0001000000010000 }π                                             $08200000,  { 0000100000100000 }π                                             $04400000,  { 0000010001000000 }π                                             $02800000,  { 0000001010000000 }π                                             $01000000,  { 0000000100000000 }π                                             $02800000,  { 0000001010000000 }π                                             $04400000,  { 0000010001000000 }π                                             $08200000,  { 0000100000100000 }π                                             $10100000,  { 0001000000010000 }π                                             $20080000,  { 0010000000001000 }π                                             $7FFC0000,  { 0111111111111100 }π                                             $00000000,  { 0000000000000000 }π                                             $00000000); { 0000000000000000 }π                                                { ^^^^ immer! (Textmodus)   }ππ      vgatextgraphicptr      : pTextgraphikcursor = @pfeil;π                                                  { @sanduhr                }π{ ─ Variablendeklarationen ──────────────────────────────────────────────── }πVAR   hidebox                : box;π      regs                   : REGISTERS;π      vgastoredarray         : ARRAY[1..3, 1..3] OF BYTE;π      lasteventx, lasteventy : WORD;π      hasstoredarray         : BOOLEAN;π      oldexitproc            : POINTER;ππCONST chardefs               : pChardefs = NIL;π      charheight             = 16;π      defchar                = $D0;πππ{ ─ exportierte Prozeduren und Funktionen ───────────────────────────────── }πprocedure swap(var a,b : word);πvar c : word;πbeginπ c := a;π a := b;π b := c; {swap a and b}πend; {swap}ππprocedure setMouseCursor(x,y : word);πbeginπ with regs do beginπ  ax := 4;π  cx := x;π  dx := y; {prepare parameters}π  INTR($33, regs);π end; {with}πend; {setMouseCursor}ππFUNCTION x : WORD;πBEGINπ  regs.AX := 3;π  INTR($33, regs);π  x := regs.CX;πEND;ππFUNCTION y : WORD;πBEGINπ  regs.AX := 3;π  INTR($33, regs);π  y := regs.DX;πEND;ππprocedure mouseBox(left,top,right,bottom : word);πbeginπ if (left > right) then swap(left,right);π if (top > bottom) then swap(top,bottom); {make sure they are ordered}π regs.ax := 7;π regs.cx := left;π regs.dx := right;π INTR($33, regs); {set x range}π regs.ax := 8;π regs.cx := top;π regs.dx := bottom;π INTR($33, regs); {set y range}πend; {mouseBox}πππPROCEDURE initmouse;πVAR overridedriver : BOOLEAN;                 { wegen Hercules-Karten       }π    tempvideomode  : BYTE;                    { Zwischenspeicher für Modus  }πBEGINπ  overridedriver := FALSE;                    { erstmal nicht override!     }ππ  IF (FALSE AND (MEM[SEG0040:$0049] = 7)) THEN  { doch overriden?           }π  BEGINπ    MEM[SEG0040:$0049] := 6;                  { Ja: Videomodus vortäuschen  }π    overridedriver := TRUE;                   {     und override setzen!    }π  END;ππ  IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }π  BEGINπ    tempvideomode := MEM[SEG0040:$0049];      { Videomodus zwischenspeichern}π    MEM[SEG0040:$0049] := 6;                  { anderen Modus vortäuschen   }π  END;ππ  WITH regs DO                                { Maustyp ermitteln           }π  BEGIN                                       { und Anzahl der Tasten auch  }π    AX := 0; BX := 0;                         { Maus initialisieren (00h)   }π    INTR($33, regs);                          { Mausinterrupt aufrufen      }ππ    mouse_present := (AX <> 0);               { überhaupt Maus vorhanden?   }π    IF (BX AND 2) <> 0 THEN mouse_buttons := twobutton  { Maustasten ermitt.}π                       ELSE IF (BX AND 3) > 0 THEN mouse_buttons := threebuttonπ                                              ELSE mouse_buttons := another;π  END;ππ  IF overridedriver = TRUE THEN MEM[SEG0040:$0049] := 7;  { override?       }π  IF vgatextgraphiccursor = TRUE THEN         { Graphikcursor im Textmodus? }π    MEM[SEG0040:$0049] := tempvideomode;      { Ja: Modus restaurieren!     }ππ  IF (NOT vgatextgraphiccursor) THEN fontpoints := mousetextscaleπ                                ELSE fontpoints := MEM[SEG0040:$0085];π  maxmousex := maxx * mousetextscale;         { Mausgrenzen ausrechnen      }π  maxmousey := maxy * fontpoints;ππ  mousebox(0, 0, (visiblex * mousetextscale)-1, (visibley * fontpoints)-1);π  eventbuttons := 0; eventhappened := FALSE;  { noch kein Event gewesen!    }ππ  xmotions := 8; ymotions := 16; mousecursorlevel := 0;  { Cursor nicht s.  }π  hasstoredarray := FALSE;                    { noch keine Daten im Array   }ππ  setmousecursor(visiblex * mousetextscale DIV 2, visibley * fontpoints DIV 2);π  eventx := x; eventy := y; lasteventx := eventx; lasteventy := eventy;πEND;ππPROCEDURE vgascreen2array(newposition, s2a, defaultrange : BOOLEAN);πVAR x, y : WORD;π    w, h : WORD;π    o, l : WORD;π    i, j : BYTE;πBEGINπ  IF (newposition = TRUE) THENπ  BEGINπ    x := eventx DIV mousetextscale;π    y := eventy DIV fontpoints;π  ENDπ  ELSEπ  BEGINπ    x := lasteventx DIV mousetextscale;π    y := lasteventy DIV fontpoints;π  END;ππ  w := visiblex - x; IF (w > 3) THEN w := 3;π  h := visibley - y; IF (h > 3) THEN h := 3;π  o := 2 * x + 2 * visiblex * y;π  l := 2 * visiblex - 2 * w;ππ  IF (defaultrange = TRUE) THENπ  BEGINπ    FOR i := 0 TO h - 1 DOπ    BEGINπ      FOR j := 0 TO w - 1 DOπ      BEGINπ        MEM[SEGB800:o] := defchar + i * 3 + j;π        INC(o, 2);π      END;π      INC(o, l);π    END;π  ENDπ  ELSEπ    IF (s2a = TRUE) THENπ    BEGINπ      FOR i := 1 TO h DOπ      BEGINπ        FOR j := 1 TO w DOπ        BEGINπ          vgastoredarray[i, j] := MEM[SEGB800:o];π          INC(o, 2)π        END;π        INC(o, l);π      END;π    ENDπ    ELSEπ    BEGINπ      FOR i := 1 TO h DOπ      BEGINπ        FOR j := 1 TO w DOπ        BEGINπ          MEM[SEGB800:o] := vgastoredarray[i, j];π          INC(o, 2);π        END;π        INC(o, l);π      END;π    END;πEND;ππPROCEDURE drawvgatextgraphiccursor;πTYPE  lp = ^LONGINT;πCONST sequencerport     = $3C4;π      sequenceraddrmode = $704;π      sequenceraddrnrml = $302;π      vgacontrolerport  = $3CE;π      cpureadmap2       = $204;π      cpuwritemap2      = $402;π      mapstartaddrA000  = $406;π      mapstartaddrB800  = $E06;π      oddevenaddr       = $304;πVAR   o, s              : WORD;π      i, j              : INTEGER;π      s1, s2, s3        : WORD;π      a                 : LONGINT;π      d, mc, ms         : lp;ππBEGINπ  ASMπ    PUSHFπ    CLIπ    MOV DX, sequencerportπ    MOV AX, sequenceraddrmodeπ    OUT DX, AXπ    MOV DX, vgacontrolerportπ    MOV AX, cpureadmap2π    OUT DX, AXπ    MOV AX, 5π    OUT DX, AXπ    MOV AX, mapstartaddrA000π    OUT DX, AXπ    POPFπ  END;ππ   o := 0;π   FOR i := 1 TO 3 DOπ   BEGINπ     s1 := vgastoredarray[i, 1] * 32;π     s2 := vgastoredarray[i, 2] * 32;π     s3 := vgastoredarray[i, 3] * 32;ππ     FOR j := 1 TO fontpoints DOπ     BEGINπ       INC(o); chardefs^[o] := MEM[SEGA000:s3];π       INC(o); chardefs^[o] := MEM[SEGA000:s2];π       INC(o); chardefs^[o] := MEM[SEGA000:s1];π       INC(o); INC(s1); INC(s2); INC(s3);π     END;π   END;ππ   s := eventx MOD mousetextscale;π   a := $FF000000 SHL (mousetextscale - s);ππ   d  := @chardefs^[(eventy MOD fontpoints) * SIZEOF(LONGINT)];π   ms := @vgatextgraphicptr^;π   mc := @vgatextgraphicptr^[charheight];ππ   FOR i := 1 TO charheight DOπ   BEGINπ     d^ := (d^ and ((ms^ shr s) or a)) or (mc^ shr s);π     INC(WORD(d), SIZEOF(LONGINT));π     INC(WORD(mc), SIZEOF(LONGINT));π     INC(WORD(ms), SIZEOF(LONGINT));π   END;ππ   ASMπ     MOV DX, sequencerportπ     MOV AX, cpuwritemap2π     OUT DX, AXπ   END;ππ   o := 0;π   for i := 0 to 2 do beginπ      s1 := (defChar + 3 * i    ) * 32;π      s2 := (defChar + 3 * i + 1) * 32;π      s3 := (defChar + 3 * i + 2) * 32;π      for j := 1 to fontPoints do beginπ         inc(o); { skip 4th byte }π         mem[segA000:s3] := charDefs^[o];π            { this code is changed to minimize DS variable space ! - RL }π         inc(o);π         mem[segA000:s2] := charDefs^[o];π         inc(o);π         mem[segA000:s1] := charDefs^[o];π         inc(o);π         inc(s1);π         inc(s2);π         inc(s3);π      end; { for j }π   end; { for i }ππ   (* now we will return the graphic adapter back to normal *)ππ   asmπ      pushf;π      cli; { disable intr .. }π      mov dx, sequencerPort;π      mov ax, sequencerAddrNrml;π      out dx, ax;π      mov ax, oddEvenAddr;π      out dx, ax;ππ      mov dx, vgaControlerPort;π      mov ax, 4; { map 0 for cpu reads }π      out dx, ax;π      mov ax, $1005;π      out dx, ax;π      mov ax, mapStartAddrB800;π      out dx, axπ      popf;π   end; { asm }ππ   vgaScreen2Array(true, false, true); { go ahead and paint it .. }ππend; {drawVGATextGraphicCursor}ππ(******************************************************************************π*                               showMouseCursor                               *π******************************************************************************)πprocedure showMouseCursor;ππbeginπ inc(mouseCursorLevel);π   if (not vgaTextGraphicCursor) then beginπ    regs.ax:=1; {enable cursor display}π    INTR($33, regs);π   end else if ((mouseCursorLevel = 1) and mouse_present) then beginπ      vgaScreen2Array(true, true, false);π      hasStoredArray := true;π      drawVGATextGraphicCursor;π   end;πend; {showMouseCursor}ππ(******************************************************************************π*                               hideMouseCursor                               *π******************************************************************************)πprocedure hideMouseCursor;ππbeginπ dec(mouseCursorLevel);π   if (not vgaTextGraphicCursor) then beginπ    regs.ax:=2; {disable cursor display}π    INTR($33, regs);π   end else if ((mouseCursorLevel = 0) and (hasStoredArray)) then beginπ      vgaScreen2Array(false, false, false);π      hasStoredArray := false;π   end;πend; {hideMouseCursor}πππ(******************************************************************************π*                                  getButton                                  *π******************************************************************************)πfunction getButton(Button : Byte) : buttonState;ππbeginπ        regs.ax := 3;π        INTR($33, regs);π        if ((regs.bx and Button) <> 0) thenπ                getButton := buttonDownπ                {bit 0 = left, 1 = right, 2 = middle}π        else getButton := buttonUp;πend; {getButton}ππ(******************************************************************************π*                                buttonPressed                                *π******************************************************************************)πfunction buttonPressed : boolean;ππbeginπ        regs.ax := 3;π        INTR($33, regs);π        if ((regs.bx and 7) <> 0) thenπ                buttonPressed := Trueπ        else buttonPressed := False;πend; {buttonPressed}πππ(******************************************************************************π*                                 lastXPress                                  *π******************************************************************************)πfunction lastXPress(Button : Byte) : word;ππbeginπ        regs.ax := 5;π        regs.bx := Button;π        INTR($33, regs);π        lastXPress := regs.cx;πend; {lastXpress}ππ(******************************************************************************π*                                 lastYPress                                  *π******************************************************************************)πfunction lastYPress(Button : Byte) : word;ππbeginπ        regs.ax := 5;π        regs.bx := Button;π        INTR($33, regs);π        lastYPress := regs.dx;πend; {lastYpress}ππ(******************************************************************************π*                                buttonPresses                                *π******************************************************************************)πfunction buttonPresses(Button : Byte) : word; {from last check}ππbeginπ        regs.ax := 5;π        regs.bx := Button;π        INTR($33, regs);π        buttonPresses := regs.bx;πend; {buttonPresses}ππ(******************************************************************************π*                                lastXRelease                                 *π******************************************************************************)πfunction lastXRelease(Button : Byte) : word;ππbeginπ        regs.ax := 6;π        regs.bx := Button;π        INTR($33, regs);π        lastXRelease := regs.cx;πend; {lastXRelease}ππ(******************************************************************************π*                                lastYRelease                                 *π******************************************************************************)πfunction lastYRelease(Button : Byte) : word;ππbeginπ        regs.ax := 6;π        regs.bx := Button;π        INTR($33, regs);π        lastYRelease := regs.dx;πend; {lastYRelease}ππ(******************************************************************************π*                               buttonReleases                                *π******************************************************************************)πfunction buttonReleases(Button : Byte) : word; {from last check}ππbeginπ        regs.ax := 6;π        regs.bx := Button;π        INTR($33, regs);π        buttonReleases := regs.bx;πend; {buttonReleases}ππ(******************************************************************************π*                             HardwareTextCursor                              *π******************************************************************************)πprocedure HardwareTextCursor(fromLine,toLine : byte);ππ{set text cursor to text, using the scan lines from..to,π        same as intr 10 cursor set in bios :π        color scan lines 0..7, monochrome 0..13 }ππbeginπ        regs.ax := 10;π        regs.bx := 1; {hardware text}π        regs.cx := fromLine;π        regs.dx := toLine;π        INTR($33, regs);πend; {hardwareTextCursor}ππ(******************************************************************************π*                             softwareTextCursor                              *π******************************************************************************)πprocedure softwareTextCursor(screenMask,cursorMask : word);ππ{ when in this mode the cursor will be achived by ANDing the screen wordπ        with the screen mask (Attr,Char in high,low order) andπ        XORing the cursor mask, ussually used by putting the screen attrπ        we want preserved in screen mask (and 0 into screen mask characterπ        byte), and character + attributes we want to set into cursor mask}ππbeginπ        regs.ax := 10;π        regs.bx := 0;        {software cursor}π        regs.cx := screenMask;π        regs.dx := cursorMask;π        INTR($33, regs);πend; {softwareMouseCursor}ππ(******************************************************************************π*                               recentXmovement                               *π******************************************************************************)πfunction recentXmovement : direction;ππ{from recent call to which direction did we move ?}ππvar d : integer;ππbeginπ        regs.ax := 11;π        INTR($33, regs);π        d := regs.cx;π        if (d > 0)π                then recentXmovement := moveRightπ        else if (d < 0)π                then recentXmovement := moveLeftπ        else recentXmovement := noMove;πend; {recentXmovement}ππ(******************************************************************************π*                               recentYmovement                               *π******************************************************************************)πfunction recentYmovement : direction;ππ{from recent call to which direction did we move ?}ππvarπ   d : integer;πbeginπ        regs.ax := 11;π        INTR($33, regs);π        d := regs.dx;π        if (d > 0)π                then recentYmovement := moveDownπ        else if (d < 0)π                then recentYmovement := moveUpπ        else recentYmovement := noMove;πend; {recentYmovement}πππ(******************************************************************************π*                               setEventHandler                               *π******************************************************************************)πprocedure setEventHandler(mask : word; handler        : pointer);ππ{handler must be a far interrupt routine }ππbeginπ        regs.ax := 12; {set event handler function in mouse driver}π        regs.cx := mask;π        regs.es := seg(handler^);π        regs.dx := ofs(handler^);π        INTR($33, regs);π        lastMask := mask;π        lastHandler := handler;πend; {set event Handler}ππ(******************************************************************************π*                               defaultHandler                                *π******************************************************************************)π{$F+} procedure defaultHandler; assembler; {$F-}πasmπ   push ds; { save TP mouse driver }π   mov ax, SEG @data;π   mov ds, ax; { ds = TP:ds, not the driver's ds }π   mov eventX, cx; { where in the x region did it occur }π   mov eventY, dx;π   mov eventButtons, bx;π   mov eventHappened, 1; { eventHapppened := true }π   pop ds; { restore driver's ds }π   ret;πend;ππ{   this is the default event handler , it simulates :ππ      beginπ               eventX := cx;π               eventY := dx;π               eventButtons := bx;π               eventhappened := True;π      end;ππ}ππ(******************************************************************************π*                                doPascalStuff                                *π* this is the pascal stuff that is called when vgaTextGraphicCursor mode has  *π* to update the screen.                                                       *π******************************************************************************)πprocedure doPascalStuff; far;πbeginπ   if (mouseCursorLevel > 0) then beginπ      if (hasStoredArray) then beginπ         VGAscreen2Array(false, false, false); { move old array to screen -πrestore }π         hasStoredArray := false;π      end;π      if (mouseCursorLevel > 0) then beginπ         VGAscreen2Array(true, true, false); { move new - from screen to arrayπ}π         hasStoredArray := true; { now we have a stored array }π         drawVGATextGraphicCursor; { do the low level stuff here }π         lastEventX := eventX;π         lastEventY := eventY; { this is the old location }π      end; { go ahead and draw it ... }π   end; { cursorLevel > 0 }πend; {doPascalStuff}ππ(******************************************************************************π*                            vgaTextGraphicHandler                            *π* this is the same as default handler, only we do the mouse location movement *π* ourself. Notice - if you use another handler, for mouse movement with       *π* VGA text graphic cursor - do the same !!!                                   *π******************************************************************************)πprocedure vgaTextGraphicHandler; far; assembler;πlabelπ   noCursorMove;πasmπ   push ds; { save TP mouse driver }π   push ax;π   mov ax, SEG @data;π   mov ds, ax; { ds = TP:ds, not the driver's ds }π   pop ax; { ax has the reason .. }π   mov eventX, cx; { where in the x region did it occur }π   mov eventY, dx;π   mov eventButtons, bx;π   mov eventHappened, 1; { eventHapppened := true }π   and ax, CURSOR_LOCATION_CHANGED; { o.k., do we need to handle mouse movement? }π   jz noCursorMove;π   call doPascalStuff;π   mov eventHappened, 0;π   { NOTICE - no movement events are detected in the out world ! - this is aπ     wintext consideration - It might be needed to track mouse movements,π     and then it should be changed ! - but this is MY default handler ! }πnoCursorMove: { no need for cursor movement handling }π   pop ds; { restore driver's ds }πend; {vgaTextGraphicHandler}ππ(******************************************************************************π*                                GetLastEvent                                 *π******************************************************************************)πfunction GetLastEvent(var x,y : word;π        var left_button,right_button,middle_button : buttonState) : boolean;ππbeginπ        getLastEvent := eventhappened; {indicate if any event happened}π        eventhappened := False; {clear to next read/event}π        x := eventX;π        y := eventY;π        if ((eventButtons and cLinke_taste) <> 0) thenπ                left_button := buttonDownπ        else left_button := buttonUp;π        if ((eventButtons and cRechte_taste) <> 0) thenπ                right_button := buttonDownπ        else right_button := buttonUp;π        if ((eventButtons and cMittlere_taste) <> 0) thenπ                middle_button := buttonDownπ        else middle_button := buttonUp;πend; {getLastEvent}ππ(******************************************************************************π*                              setDefaultHandler                              *π******************************************************************************)πprocedure setDefaultHandler(mask : WORD);ππ{get only event mask, and set event handler to defaultHandler}ππbeginπ   if (vgaTextGraphicCursor) then beginπ      mask := mask or CURSOR_LOCATION_CHANGED; { we MUST detect cursor movementπ}π           setEventHandler(mask,@vgaTextGraphicHandler);π   end elseπ           setEventHandler(mask,@defaultHandler);πend; {setDefaultHandler}ππ(******************************************************************************π*                              defineSensetivity                              *π******************************************************************************)πprocedure defineSensetivity(x,y : word);ππbeginπ        regs.ax := 15;π        regs.cx := x; {# of mouse motions to horizontal 8 pixels}π        regs.dx := y; {# of mouse motions to vertical 8 pixels}π        INTR($33, regs);π        XMotions := x;π        YMotions := y; {update global unit variables}πend; {defineSensetivity}ππ(******************************************************************************π*                              setHideCursorBox                               *π******************************************************************************)πprocedure setHideCursorBox(left,top,right,bottom : word);ππbeginπ        regs.ax := 16;π        regs.es := seg(HideBox);π        regs.dx := ofs(HideBox);π        HideBox.left := left;π        HideBox.right := right;π        HideBox.top := top;π        HideBox.bottom := bottom;π        INTR($33, regs);πend; {setHideCursorBox}ππ(******************************************************************************π*                               waitForRelease                                *π* Wait until button is release, or timeOut 1/100 seconds pass. (might miss a  *π* tenth (1/10) of a second.                                                                                                                     *π******************************************************************************)πprocedure waitForRelease(timeout : WORD);πvarπ    sHour, sMinute, sSecond, sSec100 : word;        { Time at start }π    cHour, cMinute, cSecond, cSec100 : word;        { Current time        }π    stopSec                             : longInt;π    currentSec                          : longInt;π    Delta                             : longInt;πbeginπ    getTime(sHour, sMinute, sSecond, sSec100);π    stopSec := (sHour*36000 + sMinute*600 + sSecond*10 + sSec100 + timeOut) modπ                    (24*360000);π    repeatπ           getTime(cHour, cMinute, cSecond, cSec100);π           currentSec := (cHour*36000 + cMinute*600 + cSecond*10 + cSec100);π           Delta := currentSec - stopSec;π    until (not ButtonPressed) or (Delta >=0) and (Delta < 36000);πend; {waitForRelease}ππ(******************************************************************************π*                              swapEventHandler                               *π* handler is a far routine.                                                   *π******************************************************************************)πprocedure swapEventHandler(mask : WORD; handler : POINTER);πbeginπ   regs.ax := $14;π   regs.cx := mask;π        regs.es := seg(handler^);π        regs.dx := ofs(handler^);π        INTR($33, regs);π   lastMask := regs.cx;π   lastHandler := ptr(regs.es,regs.dx);πend; {swapEventHandler}ππ(******************************************************************************π*                            getMouseSaveStateSize                            *π******************************************************************************)πfunction getMouseSaveStateSize : WORD;πbeginπ   regs.ax := $15;π   INTR($33, regs);π   getMouseSaveStateSize := regs.bx;πend; {getMouseSaveStateSize}ππ(******************************************************************************π*                           setVgaTextGraphicCursor                           *π******************************************************************************)πprocedure setVgaTextGraphicCursor;πbeginπ   vgaTextGraphicCursor := false; { assume we can not .. }π   if (queryAdapterType <> vgaColor) thenπ      exit;π   vgaTextGraphicCursor := true;πend; {setVgaTextGraphicCursor}ππ(******************************************************************************π*                          resetVgaTextGraphicCursor                          *π******************************************************************************)πPROCEDURE resetvgatextgraphiccursor;πBEGINπ  vgatextgraphiccursor := FALSE;πEND;ππPROCEDURE myexitproc; FAR;πBEGINπ  EXITPROC := oldexitproc;π  IF (vgatextgraphiccursor AND hasstoredarray) THENπ    vgascreen2array(FALSE, FALSE, FALSE);π  DISPOSE(chardefs);π  resetvgatextgraphiccursor;π  initmouse;πEND;ππPROCEDURE set_graphic_mouse_cursor;         { graphischen Mauscursor setzen }πBEGINπ  setvgatextgraphiccursor; initmouse; setdefaulthandler(left_button_pressed);πEND;ππ{ ─ Hauptprogramm der Unit ──────────────────────────────────────────────── }πBEGINπ   eventx := 0; eventy := 0; eventhappened := FALSE;π   NEW(chardefs); initmouse;π   oldexitproc := EXITPROC;π   EXITPROC    := @myexitproc;πEND.ππ